home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BMUG Revelations
/
BMUG Revelations.toast
/
Programming
/
Programming Languages
/
UCB Logo 3.0
/
CSLS
/
ttt
< prev
Wrap
Text File
|
1992-09-04
|
4KB
|
224 lines
TO BEST :LIST
OP BEST1 FIRST :LIST LAST :LIST :YOURWINS
END
TO BEST1 :BOX1 :BOX2 :WINS
IF EMPTYP :WINS [OP :BOX2]
IF MEMBERP :BOX1 FIRST :WINS [OP BEST2 :BOX1 :BOX2 BF :WINS]
OP BEST1 :BOX1 :BOX2 BF :WINS
END
TO BEST2 :BOX1 :BOX2 :WINS
IF EMPTYP :WINS [OP :BOX2]
IF MEMBERP :BOX1 FIRST :WINS [OP :BOX1]
OP BEST2 :BOX1 :BOX2 BF :WINS
END
TO BOARD
CS HT
DRAWLINE [-20 -50] 0 120
DRAWLINE [20 -50] 0 120
DRAWLINE [-60 -10] 90 120
DRAWLINE [-60 30] 90 120
END
TO CHOOSE :SIDE
PR :SIDE
IF EQUALP :SIDE "X [CHOOSEX STOP]
IF EQUALP :SIDE "O [CHOOSEO STOP]
TYPE [HUH? TYPE X OR O:]
CHOOSE RC
END
TO CHOOSEO
MAKE "ME "X
MAKE "YOU "O
END
TO CHOOSEX
MAKE "ME "O
MAKE "YOU "X
END
TO DRAW :WHO :BOX
RUN SE WORD "DRAW :WHO :BOX
END
TO DRAWLINE :POS :HEAD :LEN
PU
SETPOS :POS
SETH :HEAD
PD
FD :LEN
END
TO DRAWO :BOX
MOVE :BOX
O
END
TO DRAWX :BOX
MOVE :BOX
X
END
TO FORK1 :LIST
IF EMPTYP :LIST [OP "FALSE]
IF THING WORD "HIT FIRST :LIST [MEPLAY FIRST :LIST OP "TRUE]
MAKE WORD "HIT FIRST :LIST "TRUE
OP FORK1 BF :LIST
END
TO FORKMOVE :LISTS
IF EMPTYP :LISTS [OP "FALSE]
IF FORK1 FIRST :LISTS [OP "TRUE]
OP FORKMOVE BF :LISTS
END
TO GETMOVE
TYPE [YOUR MOVE:]
OP TRYMOVE RC
END
TO INIT
MAKE "FREE [5 1 3 7 9 2 4 6 8]
MAKE "MYWINS []
MAKE "YOURWINS []
MAKE "FREEWINS [[1 5 9] [3 5 7] [1 2 3] [4 5 6] [7 8 9] ~
[1 4 7] [2 5 8] [3 6 9]]
PR [DO YOU WANT TO PLAY FIRST (X)]
TYPE [OR SECOND (O)? TYPE X OR O:]
CHOOSE RC
PR [FOR EACH MOVE, TYPE DIGIT 1-9.]
END
TO MEPLAY :BOX
DRAW :ME :BOX
PLAY :BOX "MYWINS "YOURWINS
END
TO MOVE :BOX
PU
SETPOS THING WORD "BOX :BOX
END
TO O
SETH 0
PU
FD 8
PD
REPEAT 8 [FD 12 RT 45]
END
TO PICKMOVE
LOCAL [HIT1 HIT2 HIT3 HIT4 HIT5 HIT6 HIT7 HIT8 HIT9]
IF WINMOVE SINGLE :MYWINS [OP "TRUE]
IF WINMOVE SINGLE :YOURWINS [OP "FALSE]
ZEROHITS :FREE
IF FORKMOVE :MYWINS [OP "FALSE]
IF NOT EMPTYP :MYWINS [MEPLAY BEST FIRST :MYWINS OP "FALSE]
MEPLAY FIRST :FREE
OP "FALSE
END
TO PLAY :BOX :PLAYER :OTHER
MAKE "FREE REMOVE :BOX :FREE
MAKE :PLAYER SHORTEN :BOX THING :PLAYER
MAKE :OTHER STRIP :BOX THING :OTHER
MAKE "FREEWINS UNFREE :BOX :PLAYER :FREEWINS
END
TO PLAYLOOP
IF EMPTYP :FREE [PR [TIE!] STOP]
IF GETMOVE [PR [YOU WIN!] STOP]
IF EMPTYP :FREE [PR [TIE!] STOP]
IF PICKMOVE [PR [I WIN!] STOP]
PLAYLOOP
END
TO REMOVE :THING :LIST
IF EMPTYP :LIST [OP []]
IF EQUALP :THING FIRST :LIST [OP BF :LIST]
OP FPUT FIRST :LIST REMOVE :THING BF :LIST
END
TO SHORTEN :BOX :LIST
IF EMPTYP :LIST [OP []]
IF MEMBERP :BOX FIRST :LIST ~
[OP FPUT REMOVE :BOX FIRST :LIST SHORTEN :BOX BF :LIST]
OP FPUT FIRST :LIST SHORTEN :BOX BF :LIST
END
TO SINGLE :LIST
IF EMPTYP :LIST [OP []]
IF EMPTYP BF FIRST :LIST [OP FIRST FIRST :LIST]
OP SINGLE BF :LIST
END
TO STRIP :BOX :LIST
IF EMPTYP :LIST [OP []]
IF MEMBERP :BOX FIRST :LIST [OP STRIP :BOX BF :LIST]
OP FPUT FIRST :LIST STRIP :BOX BF :LIST
END
TO TRYMOVE :BOX
PR :BOX
IF NOT MEMBERP :BOX :FREE [PR [NOT A VALID MOVE.] OP GETMOVE]
YOUPLAY :BOX
OP MEMBERP [] :YOURWINS
END
TO TTT
LOCAL [MYWINS YOURWINS FREEWINS FREE ME YOU]
SS
BOARD
INIT
IF EQUALP :ME "X [MEPLAY 5]
PLAYLOOP
END
TO UNFREE :BOX :PLAYER :LIST
IF EMPTYP :LIST [OP []]
IF MEMBERP :BOX FIRST :LIST ~
[MAKE :PLAYER FPUT REMOVE :BOX FIRST :LIST THING :PLAYER ~
OP UNFREE :BOX :PLAYER BF :LIST]
OP FPUT FIRST :LIST UNFREE :BOX :PLAYER BF :LIST
END
TO WINMOVE :MOVE
IF EMPTYP :MOVE [OP "FALSE]
MEPLAY :MOVE
OP "TRUE
END
TO X
SETH 45
PD
FD 40
BK 20
RT 90
FD 20
BK 40
END
TO YOUPLAY :BOX
DRAW :YOU :BOX
PLAY :BOX "YOURWINS "MYWINS
END
TO ZEROHITS :LIST
IF EMPTYP :LIST [STOP]
MAKE WORD "HIT FIRST :LIST "FALSE
ZEROHITS BF :LIST
END
MAKE "BOX1 [-54 36]
MAKE "BOX2 [-14 36]
MAKE "BOX3 [26 36]
MAKE "BOX4 [-54 -4]
MAKE "BOX5 [-14 -4]
MAKE "BOX6 [26 -4]
MAKE "BOX7 [-54 -44]
MAKE "BOX8 [-14 -44]
MAKE "BOX9 [26 -44]